#lang racket


(require "../base/main.rkt")
(require "../backends/main.rkt")

(require (prefix-in com: "ac-com.rkt")
         (prefix-in alisp: "ac-autolisp.rkt")
         "ac-shape.rkt")

(provide (rename-out (com:load-autocad-com load-autocad-marshall))
         
         ; contants
         (rename-out (com:ac-active-viewport ac-active-viewport)
                     (com:ac-all-viewports ac-all-viewports)
                     (com:perspective-off perspective-off)
                     (com:perspective-on perspective-on))
         
         ; cad
         (rename-out
          (com:close close)
          (com:end-undo-mark end-undo-mark)
          (com:open open)
          (com:regen redraw)
          (com:start-undo-mark begin-undo-mark)
          (com:get-lens-length-variable get-view-lens)
          
          (alisp:erase-all-command delete-shapes)
          (alisp:redo-command redo)
          (alisp:render-command render)
          (alisp:undo-command undo)))

(provide
 ; shapes
 add-3d-face
 add-3d-poly
 add-arc
 add-box
 add-circle
 add-cone
 add-cone-frustrum
 add-cylinder
 add-ellipse
 add-line
 add-point
 add-polyline
 add-sphere
 add-spline
 
 ; operations
 add-extruded-solid
 add-region
 delete
 get-shapes
 get-visible
 intersect
 join
 loft
 move
 offset
 rotate3d
 scale
 subtract
 sweep
 union
 
 ; shape properties
 line?
 surface?
 solid?
 get-bounding-box
 visible?
 set-visible!
 
 ; arc properties
 arc?
 get-arc-center
 get-arc-radius
 get-arc-begin-angle
 get-arc-end-angle
 
 ; circle properties
 circle?
 get-circle-center
 get-circle-radius
 get-circle-normal
 
 ; object properties
 get-object-closed
 set-object-closed
 
 get-object-name
 
 ; autocad
 add-arc-ppp         
 auto-view
 get-view-center
 get-view-target
 layer
 set-view)


; shapes

(define add-3d-face
  (case-lambda
    ((p1 p2 p3)
     (make-autocad-shape
      (com:add-3d-face
       (vector<real><-coord p1)
       (vector<real><-coord p2)
       (vector<real><-coord p3))))
    ((p1 p2 p3 p4)
     (make-autocad-shape
      (com:add-3d-face
       (vector<real><-coord p1)
       (vector<real><-coord p2)
       (vector<real><-coord p3)
       (vector<real><-coord p4))))
    ((ps)
     (apply add-3d-face ps))))

(define (add-3d-poly coords)
  (make-autocad-shape
   (com:add-3d-poly
    (apply vector-append (map vector<real><-coord coords)))))

(define (add-arc center radius start-angle end-angle)
  (make-autocad-shape
   (com:add-arc
    (vector<real><-coord center)
    (real<-number radius)
    (real<-number start-angle)
    (real<-number end-angle))))

(define (add-box origin length width height)
  (make-autocad-shape
   (com:add-box
    (vector<real><-coord origin)
    (real<-number length)
    (real<-number width)
    (real<-number height))))

(define (add-circle center radius)
  (make-autocad-shape
   (com:add-circle
    (vector<real><-coord center)
    (real<-number radius))))

(define (add-cone center base-radius height)
  (make-autocad-shape
   (com:add-cone
    (vector<real><-coord center)
    (real<-number base-radius)
    (real<-number height))))

(define (add-cone-frustrum center base-radius top-radius height)
  (make-autocad-shape
   (alisp:cone-frustrum-command
    (vector<real><-coord center)
    (real<-number base-radius)
    (real<-number top-radius)
    (real<-number height))))

(define (add-cylinder center radius height)
  (make-autocad-shape
   (com:add-cylinder
    (vector<real><-coord center)
    (real<-number radius)
    (real<-number height))))

(define (add-ellipse center major-axis radius-ratio)
  (make-autocad-shape
   (com:add-ellipse
    (vector<real><-coord center)
    (vector<real><-coord major-axis)
    (real<-number radius-ratio))))

(define (add-line start-coord end-coord)
  (make-autocad-shape
   (com:add-line
    (vector<real><-coord start-coord)
    (vector<real><-coord end-coord))))

(define (add-point c)
  (make-autocad-shape
   (com:add-point
    (vector<real><-coord c))))

(define (add-polyline coords)
  (make-autocad-shape
   (com:add-polyline
    (apply vector-append (map vector<real><-coord coords)))))

(define (add-sphere center radius)
  (make-autocad-shape
   (com:add-sphere
    (vector<real><-coord center)
    (real<-number radius))))

(define (add-spline coords start-tangent end-tangent)
  (make-autocad-shape
   (com:add-spline
    (apply vector-append (list<vector<real>><-list<coord> coords))
    (vector<real><-coord start-tangent)
    (vector<real><-coord end-tangent))))


; operations

(define (add-extruded-solid profile height taper-angle)
  (make-autocad-shape
   (com:add-extruded-solid
    (autocad-shape-id profile)
    (real<-number height)
    (real<-number taper-angle))))

(define (add-region shapes)
  (map make-autocad-shape
       (vector->list
        (com:add-region
         (list->vector (map autocad-shape-id shapes))))))

(define (delete shape)
  (if (vector? (autocad-shape-id shape))
      (vector-map com:delete (autocad-shape-id shape))
      (com:delete (autocad-shape-id shape))))

(define (get-shapes)
  (let ((count (com:get-modelspace-count)))
    (map (λ. make-autocad-shape com:item) (: count))))

(define (get-visible)
  (filter visible? (get-shapes)))

(define (intersect shape1 shape2)
  (make-autocad-shape
   (com:boolean
    com:ac-intersection
    (autocad-shape-id shape1)
    (autocad-shape-id shape2))))

(define (join shapes)
  (make-autocad-shape
   (alisp:join-command (map autocad-shape-id shapes))))

(define (loft closed shapes)
  (make-autocad-shape
   (alisp:loft-command closed (map autocad-shape-id shapes))))

(define (move shape coord1 coord2)
  (make-autocad-shape
   (com:move
    (autocad-shape-id shape)
    (vector<real><-coord coord1)
    (vector<real><-coord coord2))))

(define (offset shape distance)
  (begin0
    (make-autocad-shape
     (vector-ref (com:offset (autocad-shape-id shape) (real<-number distance)) 0))
    (delete shape)))

(define (rotate3d shape coord1 coord2 rotation-angle)
  (make-autocad-shape
   (com:rotate3d
    (autocad-shape-id shape)
    (vector<real><-coord coord1)
    (vector<real><-coord coord2)
    (real<-number rotation-angle))))

(define (scale shape scale)
  (make-autocad-shape
   (com:transform-by
    (autocad-shape-id shape)
    (scale-matrix<-coord scale))))

(define (subtract shape1 shape2)
  (make-autocad-shape
   (com:boolean
    com:ac-subtraction
    (autocad-shape-id shape1)
    (autocad-shape-id shape2))))

(define (sweep shape path)
  (make-autocad-shape
   (alisp:sweep-command
    (autocad-shape-id shape)
    (autocad-shape-id path))))


; union

(define ensure-solid-height 1e-5)

(define (union shape1 shape2)
  (define (ensure-solid-shape shape)
    (if (surface? shape)
        (add-extruded-solid shape ensure-solid-height 0)
        shape))
  
  (cond ((or
          (and (solid? shape1) (solid? shape2))
          (and (surface? shape1) (surface? shape2)))
         (make-autocad-shape
          (com:boolean
           com:ac-union
           (autocad-shape-id shape1)
           (autocad-shape-id shape2))))
        (else
         (make-autocad-shape
          (com:boolean
           com:ac-union
           (autocad-shape-id (ensure-solid-shape shape1))
           (autocad-shape-id (ensure-solid-shape shape2)))))))

; /union


; shape properties

(define (line? shape)
  (let ((id (autocad-shape-id shape)))
    (or
     (com:line? id)
     (com:polyline? id)
     (com:3d-polyline? id)
     (com:spline? id))))

(define (surface? shape)
  (let ((id (autocad-shape-id shape)))
    (or
     (com:3d-face? id)
     (com:region? id))))

(define (solid? shape)
  (let ((id (autocad-shape-id shape)))
    (com:3d-solid? id)))

(define (get-bounding-box shape)
  (match (com:get-bounding-box (autocad-shape-id shape))
    ((list min-p max-p)
     (make-bbox (box-corners-pp (coord-of-vector min-p) (coord-of-vector max-p))))))

(define (visible? shape)
  (com:get-object-visible (autocad-shape-id shape)))

(define (set-visible! shape visible?)
  (com:set-object-visible! (autocad-shape-id shape) visible?))


; arc properties

(define (arc? shape)
  (com:arc? (autocad-shape-id shape)))

(define (get-arc-center shape)
  (coord-of-vector
   (com:get-arc-center (autocad-shape-id shape))))

(define (get-arc-radius shape)
  (com:get-arc-radius (autocad-shape-id shape)))

(define (get-arc-begin-angle shape)
  (com:get-arc-start-angle (autocad-shape-id shape)))

(define (get-arc-end-angle shape)
  (com:get-arc-end-angle (autocad-shape-id shape)))


; circle properties

(define (circle? shape)
  (com:circle? (autocad-shape-id shape)))

(define (get-circle-center shape)
  (coord-of-vector
   (com:get-circle-center (autocad-shape-id shape))))

(define (get-circle-radius shape)
  (com:get-circle-radius (autocad-shape-id shape)))

(define (get-circle-normal shape)
  (coord-of-vector
   (com:get-circle-normal (autocad-shape-id shape))))


; object properties

(define (get-object-closed shape)
  (com:get-object-closed (autocad-shape-id shape)))

(define (set-object-closed shape closed?)
  (com:set-object-closed (autocad-shape-id shape) closed?))

(define (get-object-name shape)
  (com:get-object-name (autocad-shape-id shape)))


; autocad

(define (add-arc-ppp p1 p2 p3)
  (make-autocad-shape
   (alisp:arc-ppp-command
    (vector<real><-coord p1)
    (vector<real><-coord p2)
    (vector<real><-coord p3))))

; edit: refactor
(define (auto-view shape/shapes direction perspective lens)
  (begin0
    shape/shapes
    (let ((shapes (if (list? shape/shapes) shape/shapes (list shape/shapes))))
      (let-values (((world-visible-shapes world-invisible-shapes) (partition visible? (get-shapes)))
                   ((visible-shapes invisible-shapes) (partition visible? shapes)))
        (let ((remaining-shapes (remove* visible-shapes world-visible-shapes autocad-shape=?)))
          (map (λ (shape) (set-visible! shape #f)) remaining-shapes)
          (map (λ (shape) (set-visible! shape #t)) invisible-shapes)
          (let ((direction-x (xyz-x direction))
                (direction-y (xyz-y direction))
                (direction-z (xyz-z direction)))
            (alisp:auto-view-command direction-x direction-y direction-z perspective lens))
          (map (λ (shape) (set-visible! shape #t)) remaining-shapes)
          (map (λ (shape) (set-visible! shape #f)) invisible-shapes))))))

(define (get-view-center)
  (add-c
   (coord-of-vector (com:get-viewdir-variable))
   (coord-of-vector (com:get-target-variable))))

(define (get-view-target)
  (coord-of-vector (com:get-target-variable)))

(define (layer name)
  (let ((l (com:item-document-layers name)))
    (let ((l (if l l (com:add-document-layers name))))
      (com:set-document-active-layer l))))

(define (set-view shape/shapes center target perspective lens)
  (begin0
    shape/shapes
    (alisp:set-view-command
     (xyz-x center) (xyz-y center) (xyz-z center)
     (xyz-x target) (xyz-y target) (xyz-z target)
     perspective
     lens
     (distance center target))))